home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / TEST / DEFUSRFI.M < prev    next >
Encoding:
Text File  |  1991-08-01  |  2.8 KB  |  79 lines
  1. MODULE Fill;
  2.  
  3. FROM SYSTEM IMPORT ASSEMBLER;
  4. FROM Storage       IMPORT ALLOCATE;
  5. FROM GrafBase      IMPORT black,Pnt,Rect,WordBitSet;
  6. FROM GEMGlobals    IMPORT FillType;
  7. FROM GEMEnv        IMPORT RC,DeviceHandle,GemHandle,InitGem,ExitGem,
  8.                           CurrGemHandle;
  9. FROM VDIControls   IMPORT ClearWorkstation;
  10. FROM VDIAttributes IMPORT SetFillType,SetFillColor,SetFillIndex,PtrFillPattern,
  11.                           DefUserFill;
  12. FROM VDIInputs     IMPORT HideCursor, ShowCursor;
  13. FROM VDIOutputs    IMPORT GrafText,FillRectangle;
  14. FROM Terminal      IMPORT Read;
  15.  
  16.  
  17. VAR Geraet: DeviceHandle;
  18.     GemKennung: GemHandle;
  19.     pattern: PtrFillPattern;
  20.     ok: BOOLEAN;
  21.     c: CHAR;
  22.     
  23. BEGIN
  24.  
  25.   (* Füllmuster definieren *)
  26.   ALLOCATE(pattern,SIZE(pattern));
  27.   
  28.   (* Hohe Auflösung: *)
  29.   pattern^.planes:=1;
  30.   
  31.   (* Füllmuster: *)
  32.   pattern^.hiResPlane[0]:= WordBitSet(02222H);
  33.   pattern^.hiResPlane[1]:= WordBitSet(0);
  34.   pattern^.hiResPlane[2]:= WordBitSet(08888H);
  35.   pattern^.hiResPlane[3]:= WordBitSet(0);
  36.   pattern^.hiResPlane[4]:= WordBitSet(02A2AH);
  37.   pattern^.hiResPlane[5]:= WordBitSet(0);
  38.   pattern^.hiResPlane[6]:= WordBitSet(08888H);
  39.   pattern^.hiResPlane[7]:= WordBitSet(0);
  40.   pattern^.hiResPlane[8]:= WordBitSet(02222H);
  41.   pattern^.hiResPlane[9]:= WordBitSet(0);
  42.   pattern^.hiResPlane[10]:=WordBitSet(08888H);
  43.   pattern^.hiResPlane[11]:=WordBitSet(0);
  44.   pattern^.hiResPlane[12]:=WordBitSet(02A2AH);
  45.   pattern^.hiResPlane[13]:=WordBitSet(0);
  46.   pattern^.hiResPlane[14]:=WordBitSet(08888H);
  47.   pattern^.hiResPlane[15]:=WordBitSet(0);
  48.  
  49.   InitGem(RC, Geraet, ok);        (* Programm beim GEM anmelden         *)
  50.   IF NOT ok THEN HALT END;        (* GEM will nicht => brutal Abbrechen *)
  51.   GemKennung := CurrGemHandle();  (* GEM-Handle beschaffen              *)
  52.   HideCursor(Geraet);             (* Maus weg                           *)
  53.   ClearWorkstation(Geraet);       (* Bildschirm löschen                 *)
  54.   SetFillColor(Geraet,black);     (* Füllfarbe schwarz                  *)
  55.   
  56.   
  57.   SetFillType(Geraet,userPattern);(* Benutzerdefiniertes Füllmuster     *)
  58.   DefUserFill(Geraet,pattern);    (* Füllmuster definieren              *)
  59.   
  60.   (****** AB HIER TUT SICH NICHTS MEHR **********************************)
  61.   
  62.   (*
  63.      Diese zwei Zeilen funktioniern, im Gegensatz zu den obigen zwei:
  64.   
  65.      SetFillType(Geraet,dottPattern);
  66.      SetFillIndex(Geraet,10);
  67.      
  68.    *)
  69.    
  70.    
  71.   FillRectangle(Geraet,Rect(20,20,200,200));    (* Rechteck füllen      *)
  72.   GrafText(Geraet,Pnt(20,300),"Taste ....");    (* Info für Benutzer    *)
  73.   Read(c);                                      (* Warten auf Taste     *)
  74.   ShowCursor(Geraet,FALSE);                     (* Maus zeigen          *)
  75.   
  76.   ExitGem(GemKennung)                           (* Abmelden             *)
  77.  
  78. END Fill.
  79.